Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Pascal/Snippets/3DBouncer/3DBouncer.p

Text File | 1995-12-30 | 21.1 KB | 770 lines | [TEXT/PJMM]

{3D Bouncing Ball Module}
{Written by Daniel C. Stegman, Exodus Software}
{©1992, Exodus Software, All Rights Reserved.}
{This code is intended for use as a After Dark 2.0 ScreenSaver Module.  It is intended for entertainment}
{use, and for the enlightenment of programmers.  It uses fixed math to optimize all of it's 3D calculations,}
{and uses Color on those macs that can support it.  Enjoy!!}
{Dedicated to the Hackers of MacHack, 1992}

{Ken Long started the conversion to a stand-alone application, and Ingemar Ragnemalm finished}
{that conversion, plus added sound (with stereo panning).}

program GraphicsDemo;

    uses
{$IFC UNDEFINED THINK_PASCAL}
        Types, Memory, Packages, Quickdraw, ToolUtils, TextEdit,{}
        Dialogs, Windows, Fonts,
{$ENDC}
        Sound, CheapSound2, FixMath;

{$IFC UNDEFINED THINK_PASCAL}
    var
        white, black, ltGray, gray, dkGray: Pattern;
{$ENDC}

    const
        kRedColor = 1;
        kBlueColor = 2;
        kGreenColor = 3;
        kPurpleColor = 4;
        kYellowColor = 5;
        kOrangeColor = 6;
        kWhiteColor = 7;

        forceGray = false;
        kNumBalls = 5;

    const
        kSmackSoundId = 1000;
        kBounceSoundId = 1001;

    type
        ThreeDeePoint = record
                x: fixed;
                y: fixed;
                z: fixed;
            end;

        ThreeDeeWorld = record
                eyeLocation: ThreeDeePoint;
                screenCenter: ThreeDeePoint;
                screenRect: Rect;
                frontTopLeft: ThreeDeePoint;
                frontTopRight: ThreeDeePoint;
                frontBotLeft: ThreeDeePoint;
                frontBotRight: ThreeDeePoint;
                backTopLeft: ThreeDeePoint;
                backTopRight: ThreeDeePoint;
                backBotLeft: ThreeDeePoint;
                backBotRight: ThreeDeePoint;
                plutoScaling: real;
            end;
        WorldPtr = ^ThreeDeeWorld;
        WorldHdl = ^WorldPtr;

        RectArray = array[1..10] of Rect;
        TheBall = record
                its3DLoc: ThreeDeePoint;
                itsShadow: ThreeDeePoint;
                its2DLoc: point;
                sh2DLoc: point;
                oldRect: rect;
                Old2DRects: RectArray;
                Oldsh2DRects: RectArray;
                bounceCount: integer;
                xVector: fixed;
                yVector: fixed;
                zVector: fixed;
                itsColor: RGBColor;
                colorCode: integer;
                gravity: integer;
                speed: integer;
                shadowVis: boolean;
            end;

        BallArray = array[1..5] of TheBall;

        TempStorage = record
                aBall: TheBall;
                bBall: TheBall;
                cBall: TheBall;
                dBall: TheBall;
                eBall: TheBall;
                doColor: boolean;
{forceGray: boolean;}
                kWhiteRGB: RGBColor;
                kGrayRGB: RGBColor;
                kBlackRGB: RGBColor;
                rotaryColor: integer;
                numballs: integer;
                theBalls: ballArray;
                aBox: ThreeDeeWorld;
            end;
        TempPtr = ^TempStorage;
        TempHdl = ^TempPtr;

        IntegerHandle = ^IntegerPtr;
        BooleanPtr = ^Boolean;
        BooleanHandle = ^BooleanPtr;

    var
        colorQDAvail: Boolean;

    procedure SetThreeDeePoint (var tempPt: ThreeDeePoint; x, y, z: real);
    begin
        tempPt.x := X2Fix(x);
        tempPt.y := X2Fix(y);
        tempPt.z := X2Fix(z);
    end;

    procedure ThreeDeeToTwoDee (theWorld: ThreeDeeWorld; aThreeDeePoint: ThreeDeePoint; var a2DPoint: point);
        var
            x1, y1, z1: fixed;
            x2, y2, z2: fixed;
            tempFixed: fixed;
    begin
        with theWorld do
            begin
                x1 := screenCenter.x - aThreeDeePoint.x;
                y1 := screenCenter.y - aThreeDeePoint.y;
                z1 := eyeLocation.z - aThreeDeePoint.z;
                z2 := screenCenter.z - aThreeDeePoint.z;

                x2 := FixDiv(FixMul(x1, z2), z1);
                y2 := FixDiv(FixMul(y1, z2), z1);

                x2 := FixMul(x1, FixDiv(z2, z1));
                y2 := FixMul(y1, FixDiv(z2, z1));

                tempFixed := x2 + screenCenter.x - x1;
                a2DPoint.h := Fix2Long(tempFixed);
                tempFixed := y2 + screenCenter.y - y1;
                a2DPoint.v := Fix2Long(tempFixed);
            end;
    end; {ThreeDeeToTwoDee}

    procedure ScaleRect (var tempRect: rect; scaleFactor: real);
        var
            itsCenter: Point;
            itsWidth: integer;
            itsHeight: integer;
    begin
        itsWidth := tempRect.right - tempRect.left;
        itsHeight := tempRect.bottom - tempRect.top;
        itsCenter.h := tempRect.left + itsWidth div 2;
        itsCenter.v := tempRect.top + itsHeight div 2;

        tempRect.left := Round(itsCenter.h - (itsWidth * scaleFactor) / 2);
        tempRect.top := Round(itsCenter.v - (itsHeight * scaleFactor) / 2);

        tempRect.right := tempRect.left + Round(itsWidth * scaleFactor);
        tempRect.bottom := tempRect.top + Round(itsHeight * scaleFactor);
    end; {ScaleRect}

    procedure SetupThreeDeeWorld (var tempWorld: ThreeDeeWorld; monitorRect: rect);
        var
            monitorWidth: real;
            monitorHeight: real;
            monitorDepth: real;
    begin
        with tempWorld do
            begin
                monitorHeight := monitorRect.bottom - monitorRect.top;
                monitorWidth := monitorRect.right - monitorRect.left;
                monitorDepth := monitorWidth;
                SetThreeDeePoint(eyeLocation, (monitorWidth / 2), 0, -200);
                SetThreeDeePoint(screenCenter, (monitorWidth / 2), (monitorHeight / 4), -50);
                SetThreeDeePoint(eyeLocation, (monitorWidth / 2), -200, -500);
                SetThreeDeePoint(screenCenter, (monitorWidth / 2), (monitorHeight / 4), -100);

            {SetThreeDeePoint(eyeLocation, 0, 100, 0);}
{            SetThreeDeePoint(screenCenter, 0, 100, 50);}
                screenRect := monitorRect;

                SetThreeDeePoint(frontTopLeft, monitorRect.left, monitorRect.top, 0);
                SetThreeDeePoint(frontTopRight, monitorRect.right, monitorRect.top, 0);
                SetThreeDeePoint(frontBotLeft, monitorRect.left, monitorRect.bottom, 0);
                SetThreeDeePoint(frontBotRight, monitorRect.right, monitorRect.bottom, 0);
                SetThreeDeePoint(backTopLeft, monitorRect.left, monitorRect.top, monitorDepth);
                SetThreeDeePoint(backTopRight, monitorRect.right, monitorRect.top, monitorDepth);
                SetThreeDeePoint(backBotLeft, monitorRect.left, monitorRect.bottom, monitorDepth);
                SetThreeDeePoint(backBotRight, monitorRect.right, monitorRect.bottom, monitorDepth);

{    SetThreeDeePoint(frontTopLeft, -monitorWidth, monitorWidth, -monitorWidth);}
{    SetThreeDeePoint(frontTopRight, monitorWidth, monitorWidth, -monitorWidth);}
{    SetThreeDeePoint(frontBotLeft, -monitorWidth, 0, -monitorWidth);}
{    SetThreeDeePoint(frontBotRight, monitorWidth, 0, -monitorWidth);}
{    SetThreeDeePoint(backTopLeft, -monitorWidth, monitorWidth, monitorWidth);}
{    SetThreeDeePoint(backTopRight, monitorWidth, monitorWidth, monitorWidth);}
{    SetThreeDeePoint(backBotLeft, -monitorWidth, 0, monitorWidth);}
{    SetThreeDeePoint(backBotRight, monitorWidth, 0, monitorWidth);    }
            end;
    end; {SetupThreeDeeWorld}

    procedure InitializeArray (var itsRectArray: RectArray);
        var
            count: integer;
    begin
        for count := 1 to 10 do
            SetRect(itsRectArray[count], 1, 1, 1, 1);
    end;

    procedure ShiftArray (var itsRectArray: RectArray);
        var
            count: integer;
    begin
        for count := 9 downto 1 do
            itsRectArray[count + 1] := itsRectArray[count];
    end;

    procedure InitBall (var ballA: TheBall; boxA: ThreeDeeWorld; doColor, forceGray: boolean);
        var
            two: fixed;
            eightTenths: fixed;
            tempFixed: fixed;
            newColor: integer;

        function ReturnMagicColor (tempValue: integer): RGBColor;
            var
                tempColor: RGBColor;
                newColor: integer;
        begin
            tempColor.red := 0;
            tempColor.green := 0;
            tempColor.blue := 0;
            case tempValue of
                kRedColor:
                    begin
                        tempColor.red := -1;
                    end;
                kBlueColor:
                    begin
                        tempColor.blue := -1;
                    end;
                kGreenColor:
                    begin
                        tempColor.green := -1;
                    end;
                kPurpleColor:
                    begin
                        tempColor.red := -1;
                        tempColor.blue := -1;
                    end;
                kYellowColor:
                    begin
                        tempColor.red := -1;
                        tempColor.green := -1;
                    end;
                kOrangeColor:
                    begin
                        tempColor.red := -1;
                        tempColor.green := 32767;
                    end;
                otherwise
                    begin
                        tempColor.red := -1;
                        tempColor.blue := -1;
                        tempColor.green := -1;
                    end;
            end;
            ReturnMagicColor := tempColor;
        end;
    begin
        with ballA, boxA do
            begin
                two := Long2Fix(2);
                eightTenths := X2Fix(0.8);

                gravity := 0;
                speed := 5;
                shadowVis := true;

{        gravity := 20;}
{        speed := 40;}
{        shadowVis := TRUE;    }
                tempFixed := frontTopRight.x - frontTopLeft.x;

                its3DLoc.x := FixDiv(tempFixed, two);
                its3DLoc.y := frontTopLeft.y;
                its3DLoc.z := its3DLoc.x;
{Change by Ingemar: Long2Fix(Random mod speed) gives an integer in fixed-point, which is}
{less nice than a full random fixed-point number. Also, I don't want it to be zero.}
                repeat
                    xVector := Longint(Random) * speed * 2;
                until xVector <> 0;
                repeat
                    yVector := Longint(Abs(Random)) * speed * 2;
                until yVector <> 0;
                repeat
                    zVector := Longint(Random) * speed * 2;
                until zVector <> 0;
                if doColor then
                    begin
                        if forceGray then
                            newColor := kWhiteColor
                        else
                            newColor := Abs(Random) mod 7 + 1;
                        itsColor := ReturnMagicColor(newColor);
                        colorCode := newColor;
                    end;
{    Cannon Settings    }
{    its3DLoc.x := FixDiv(tempFixed, two);}
{    its3DLoc.y := FixMul((frontBotLeft.y - frontTopLeft.y), eightTenths);}
{    its3DLoc.z := frontBotLeft.z;}
{    xVector := Long2Fix(random mod speed);}
{    yVector := Long2Fix(- abs(random mod 30));}
{    zVector := Long2Fix(40 + abs(random mod 30));    }

                bounceCount := 0;
            end;
    end; {InitBall}

    function DoInitialize (var storage: Handle; blankRgn: RgnHandle; window: WindowPtr): OSErr;
    {Allocate memory and initialize variables here}
        var
            index: integer;
            bHdl: Handle;
            aRect: rect;
            two: fixed;
            tempFixed: fixed;
            aHdl: TempHdl;
    begin
        aHdl := TempHdl(NewHandle(sizeof(tempStorage)));
        HLock(Handle(aHdl)); {Better lock it. We'll be dereferencing it a lot! /Ingemar}

        if aHdl <> nil then
            begin
                aRect := window^.portRect;
                SetupThreeDeeWorld(aHdl^^.aBox, aRect);

                with aHdl^^, aBall, aBox do
                    begin
                        numballs := kNumBalls;
                        if numBalls > 5 then
                            numBalls := 5;

                        doColor := true;

                        kWhiteRGB.red := -1;
                        kWhiteRGB.green := -1;
                        kWhiteRGB.blue := -1;
                        kGrayRGB.red := 32767;
                        kGrayRGB.green := 32767;
                        kGrayRGB.blue := 32767;
                        kBlackRGB.red := 0;
                        kBlackRGB.green := 0;
                        kBlackRGB.blue := 0;

                        rotaryColor := 1;

                        for index := 1 to numBalls do
                            begin
                                InitializeArray(theBalls[index].Old2DRects);
                                InitializeArray(theBalls[index].OldSH2DRects);
                                InitBall(theBalls[index], aBox, doColor, forceGray);
                                rotaryColor := rotaryColor + 1;
                            end;

                        FillRect(aBox.screenRect, black);
                    end;
                storage := Handle(aHdl);
                DoInitialize := noErr;
            end
        else
            DoInitialize := MemError;
    end; {DoInitialize}

    function DoBlank (storage: Handle; blankRgn: RgnHandle): OSErr;
    {Blank the screen.  You could also have "credits" appear on the screen here}
    begin
        FillRgn(blankRgn, black);
        DoBlank := noErr;
    end; {DoBlank}

    procedure PlaceSound (id: Integer; var loc, box: ThreeDeePoint);
        var
            h, v, hmax, vmax, dist, place: Longint;
    begin
        h := Point(loc.x).v;
        v := Point(loc.z).v;
        hmax := Point(box.x).v;
        vmax := Point(box.z).v;

        place := h * 256 div hmax;
        dist := 256 - v * 128 div vmax;

        PlaySound(id, (256 - place) * dist div 256, place * dist div 256);
    end; {PlaceSound}

    function MoveBall (var ballA: TheBall; boxA: ThreeDeeWorld; doColor, forceGray: boolean): boolean;
        var
            tempFixed: fixed;
            two: fixed;
            anErr: OSErr;
    begin
        with ballA, boxA do
            begin
        { Update the location by applying the vectors }
                its3DLoc.x := its3DLoc.x + xVector;
                its3DLoc.y := its3DLoc.y + yVector;
                its3DLoc.z := its3DLoc.z + zVector;
                yVector := yVector + X2Fix(gravity / 20);

        {    Check for out of bounds    }
                if its3DLoc.x <= frontTopLeft.x then
                    begin
                        its3DLoc.x := frontTopLeft.x;
                        xVector := -xVector;
                        PlaceSound(kBounceSoundId, its3DLoc, boxA.backBotRight);
                    end
                else if its3DLoc.x >= frontTopRight.x then
                    begin
                        its3DLoc.x := frontTopRight.x;
                        xVector := -xVector;
                        PlaceSound(kBounceSoundId, its3DLoc, boxA.backBotRight);
                    end;

                if its3DLoc.y <= frontTopLeft.y then
                    begin
                        its3DLoc.y := frontTopLeft.y;
                        yVector := -yVector;
                        PlaceSound(kBounceSoundId, its3DLoc, boxA.backBotRight);
                    end
                else if its3DLoc.y >= frontBotLeft.y then
                    begin
                        its3DLoc.y := frontBotLeft.y;
                        if gravity > 0 then
                            begin
                                yVector := FixMul(-yVector, X2Fix(2 / 3));
                                xVector := FixMul(xVector, X2Fix(3 / 4));
                                zVector := FixMul(zVector, X2Fix(3 / 4));
                            end
                        else
                            begin
                                yVector := -yVector;
                            end;
                        bounceCount := bounceCount + 1;
                        if bounceCount = 8 then
                            begin
                                InitBall(ballA, boxA, doColor, forceGray);
                            end;
                        PlaceSound(kBounceSoundId, its3DLoc, boxA.backBotRight);
                    end;

                if its3DLoc.z <= frontTopLeft.z then
                    begin
                        its3DLoc.z := frontTopLeft.z;
                        zVector := -zVector;
                        PlaceSound(kSmackSoundId, its3DLoc, boxA.backBotRight);
                    end
                else if its3DLoc.z >= backTopRight.z then
                    begin
                        its3DLoc.z := backTopRight.z;
                        zVector := -zVector;
                        PlaceSound(kSmackSoundId, its3DLoc, boxA.backBotRight);
                    end;
            end;
    end; {MoveBall}

    procedure DrawBox (boxA: ThreeDeeWorld; kWhiteRGB, kGrayRGB, kBlackRGB: RGBColor);
        var
            itsRect: rect;
            tempPt1: point;
            tempPt2: point;
    begin
        with boxA do
            begin
                if colorQDAvail then
                    RGBForeColor(kGrayRGB)
                else
                    PenPat(white);

                ThreeDeeToTwoDee(boxA, frontTopLeft, tempPt1);
                ThreeDeeToTwoDee(boxA, frontBotRight, tempPt2);
                SetRect(itsRect, tempPt1.h, tempPt1.v, tempPt2.h, tempPt2.v);
                FrameRect(itsRect);
                ThreeDeeToTwoDee(boxA, backTopLeft, tempPt1);
                ThreeDeeToTwoDee(boxA, BackBotRight, tempPt2);
                SetRect(itsRect, tempPt1.h, tempPt1.v, tempPt2.h, tempPt2.v);
                FrameRect(itsRect);
                ThreeDeeToTwoDee(boxA, frontTopLeft, tempPt1);
                MoveTo(tempPt1.h, tempPt1.v);
                ThreeDeeToTwoDee(boxA, backTopLeft, tempPt1);
                LineTo(tempPt1.h, tempPt1.v);
                ThreeDeeToTwoDee(boxA, frontTopRight, tempPt1);
                MoveTo(tempPt1.h, tempPt1.v);
                ThreeDeeToTwoDee(boxA, backTopRight, tempPt1);
                LineTo(tempPt1.h, tempPt1.v);
                ThreeDeeToTwoDee(boxA, frontBotLeft, tempPt1);
                MoveTo(tempPt1.h, tempPt1.v);
                ThreeDeeToTwoDee(boxA, backBotLeft, tempPt1);
                LineTo(tempPt1.h, tempPt1.v);
                ThreeDeeToTwoDee(boxA, frontBotRight, tempPt1);
                MoveTo(tempPt1.h, tempPt1.v);
                ThreeDeeToTwoDee(boxA, backBotRight, tempPt1);
                LineTo(tempPt1.h, tempPt1.v);
                if colorQDAvail then
                    RGBForeColor(kWhiteRGB);
            end;
    end; {DrawBox}

    procedure UpdateBall (var ballA: TheBall; aBox: ThreeDeeWorld; kWhiteRGB, kGrayRGB, kBlackRGB: RGBColor);
        var
            itsSize: integer;
            zDepth: fixed;
            itsScale: fixed;
            itsRect: rect;
            shRect: rect;
            tempString1: Str255;
            tempString2: Str255;

        procedure RampDownColor (tempColor: RGBColor; colorCode, degradeBy: integer);
            var
                degradeVal: Integer;
        begin
    {    degradeVal := trunc(65000 / (1.0 * degradeBy));    }
            degradeVal := 65000 div degradeBy;

            if colorQDAvail then
                begin
                    case colorCode of
                        kRedColor:
                            begin
                                tempColor.red := degradeVal;
                            end;
                        kBlueColor:
                            begin
                                tempColor.blue := degradeVal;
                            end;
                        kGreenColor:
                            begin
                                tempColor.green := degradeVal;
                            end;
                        kPurpleColor:
                            begin
                                tempColor.red := degradeVal;
                                tempColor.blue := degradeVal;
                            end;
                        kYellowColor:
                            begin
                                tempColor.red := degradeVal;
                                tempColor.green := degradeVal;
                            end;
                        kOrangeColor:
                            begin
                                tempColor.red := degradeVal;
                                tempColor.green := degradeVal;            { Make it yellow since Orange fades fast }
                            end;
                        otherwise
                            begin
                                tempColor.red := degradeVal;
                                tempColor.blue := degradeVal;
                                tempColor.green := degradeVal;
                            end;
                    end;
                    RGBForeColor(tempColor);
                end
            else
                begin
                    case degradeBy of
                        1:
                            PenPat(white);
                        2..4:
                            PenPat(ltGray);
                        5..7:
                            PenPat(gray);
                        otherwise
                            PenPat(dkGray);
                    end;
                end;
        end; {RampDownColor}

    begin {UpdateBall}
        zDepth := abs(aBox.frontTopLeft.z - aBox.backTopLeft.z);
        itsScale := FixDiv((aBox.backTopLeft.z - ballA.its3DLoc.z), aBox.backTopLeft.z);
        itsSize := 4 + Fix2Long(FixMul(itsScale, Long2Fix(20)));

        itsRect.left := ballA.its2DLoc.h - (itsSize div 2);
        itsRect.right := ballA.its2DLoc.h + (itsSize div 2);
        itsRect.top := ballA.its2DLoc.v - (itsSize div 2);
        itsRect.bottom := ballA.its2DLoc.v + (itsSize div 2);
        if ballA.shadowVis then
            begin
                shRect.left := ballA.sh2DLoc.h - (itsSize div 2);
                shRect.right := ballA.sh2DLoc.h + (itsSize div 2);
                shRect.top := ballA.sh2DLoc.v - (itsSize div 4);
                shRect.bottom := ballA.sh2DLoc.v + (itsSize div 4);
            end;
        {RGBForeColor(kWhiteRGB);}
        if colorQDAvail then
            RGBForeColor(kWhiteRGB)
        else
            PenPat(white);
        with ballA do
            begin
                if colorQDAvail then
                    begin
                        RGBForeColor(kBlackRGB);
                        PaintOval(Old2DRects[10]);
                        PaintOval(Old2DRects[1]);
                        if shadowVis then
                            PaintOval(OldSh2DRects[10]);
                    end
                else
                    begin
                        FillOval(Old2DRects[10], black);
                        FillOval(Old2DRects[1], black);
                        if shadowVis then
                            FillOval(OldSh2DRects[10], black);
                    end;

                ShiftArray(Old2DRects);
                Old2DRects[1] := itsRect;
                ShiftArray(OldSh2DRects);
                OldSh2DRects[1] := shRect;

                RampDownColor(itsColor, colorCode, 10);
                FrameOval(Old2DRects[10]);
                RampDownColor(itsColor, colorCode, 9);
                FrameOval(Old2DRects[9]);
                RampDownColor(itsColor, colorCode, 8);
                FrameOval(Old2DRects[8]);
                RampDownColor(itsColor, colorCode, 7);
                FrameOval(Old2DRects[7]);
                RampDownColor(itsColor, colorCode, 6);
                FrameOval(Old2DRects[6]);
                RampDownColor(itsColor, colorCode, 5);
                FrameOval(Old2DRects[5]);
                RampDownColor(itsColor, colorCode, 4);
                FrameOval(Old2DRects[4]);
                RampDownColor(itsColor, colorCode, 3);
                FrameOval(Old2DRects[3]);
                RampDownColor(itsColor, colorCode, 2);
                FrameOval(Old2DRects[2]);
                if colorQDAvail then
                    RGBForeColor(itsColor)
                else
                    PenPat(white);
                PaintOval(Old2DRects[1]);

                if shadowVis then
                    begin
                        RampDownColor(itsColor, colorCode, 10);
                        FrameOval(OldSh2DRects[10]);
                        RampDownColor(itsColor, colorCode, 9);
                        FrameOval(OldSh2DRects[9]);
                        RampDownColor(itsColor, colorCode, 8);
                        FrameOval(OldSh2DRects[8]);
                        RampDownColor(itsColor, colorCode, 7);
                        FrameOval(OldSh2DRects[7]);
                        RampDownColor(itsColor, colorCode, 6);
                        FrameOval(OldSh2DRects[6]);
                        RampDownColor(itsColor, colorCode, 5);
                        FrameOval(OldSh2DRects[5]);
                        RampDownColor(itsColor, colorCode, 4);
                        FrameOval(OldSh2DRects[4]);
                        RampDownColor(itsColor, colorCode, 3);
                        FrameOval(OldSh2DRects[3]);
                        RampDownColor(itsColor, colorCode, 2);
                        FrameOval(OldSh2DRects[2]);
                        if colorQDAvail then
                            RGBForeColor(itsColor)
                        else
                            PenPat(white);
                        FrameOval(OldSh2DRects[1]);
                    end;
            end;
    end; {UpdateBall}

    function DoDrawFrame (storage: Handle; blankRgn: RgnHandle): OSErr;
    {This function is repeatedly called by After Dark.  This is where the main drawing is done.}
        var
            aHdl: TempHdl;
            movement: boolean;
            index: integer;
            waited: longint;
    begin
        aHdl := TempHdl(storage);
        with aHdl^^ do
            begin
                for index := 1 to numBalls do
                    begin
                        movement := MoveBall(theBalls[index], aBox, doColor, forceGray);
                        ThreeDeeToTwoDee(aBox, theBalls[index].its3DLoc, theBalls[index].its2DLoc);
                        theBalls[index].itsShadow := theBalls[index].its3DLoc;
                        theBalls[index].itsShadow.y := aBox.frontBotRight.y;
                        ThreeDeeToTwoDee(aBox, theBalls[index].itsShadow, theBalls[index].sh2DLoc);
                        UpdateBall(theBalls[index], aBox, kWhiteRGB, kGrayRGB, kBlackRGB);
                    end;

                DrawBox(aBox, kWhiteRGB, kGrayRGB, kBlackRGB);
            end;
        DoDrawFrame := noErr;
    end; {DoDrawFrame}

    function DoClose (storage: Handle; blankRgn: RgnHandle): OSErr;
    {Deallocate your memory here.  You can also put something on the screen.}
    begin
        if colorQDAvail then
            begin
                RGBForeColor(TempHdl(storage)^^.kWhiteRGB);
                RGBBackColor(TempHdl(storage)^^.kBlackRGB);
            end;
        DisposeHandle(storage);
        DoClose := noErr;
    end; {DoClose}

    function DoSetup (blankRgn: RgnHandle; message: integer): OSErr;
    {This is called when the user clicks on a button in the Control Panel.}
    begin
        DoSetup := noErr;
    end; {DoSetup}

    var
        myRect: Rect;
        window: WindowPtr;
        storage: Handle;
        err: OSErr;
begin
{$IFC UNDEFINED THINK_PASCAL}
    InitGraf(@qd.thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(nil);
    MaxApplZone;

    white := qd.white;
    black := qd.black;
    ltGray := qd.ltGray;
    gray := qd.gray;
    dkGray := qd.dkGray;
{$ENDC}

{Quickest way to check for Color QD and 32-bit QD:}
    colorQDAvail := NGetTrapAddress($AA1E, toolTrap) <> NGetTrapAddress($A89F, toolTrap);    {Do we have GetCIcon…}
    colorQDAvail := colorQDAvail and (NGetTrapAddress($AB1D, toolTrap) <> NGetTrapAddress($A89F, toolTrap)); {…and 32-bit QD too?}

{$IFC UNDEFINED THINK_PASCAL}
    qd.randSeed := TickCount;
{$ELSEC}
    randSeed := TickCount;
{$ENDC}

    SetRect(myRect, 40, 40, 450, 350);
    if colorQDAvail then
        window := NewCWindow(nil, myRect, 'Click to exit', true, noGrowDocProc, pointer(-1), true, 0)
    else
        window := NewWindow(nil, myRect, 'Click to exit', true, noGrowDocProc, pointer(-1), true, 0);
    SetPort(window);

    err := DoBlank(storage, window^.visRgn);
    err := DoInitialize(storage, window^.visRgn, window);

    repeat
        err := DoDrawFrame(storage, window^.visRgn);
    until Button;
    TerminateSound;
end.